perm filename FILDIS.FAI[XX,LCS] blob sn#267328 filedate 1977-02-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN FILLMS
C00014 ENDMK
C⊗;
BEGIN FILLMS
	TITLE FILLMS
	ENTRY FILLMS,DST,LL
	EXTERNAL DL,PLTR,STF,ALF,LINES,UNPACK,RINP,.COMM.
DEFINE R9< .COMM.+=10>
DST:	0.005  			;BB
	2.2			;CC
LL:	0
;******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
;	SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
;	COMMON/DL/RSIZ,SAVER,NAME
;	COMMON/DST/BB,CC/FLM/X(600)
;	DIMENSION IDAT(1),NX(600)
;	EQUIVALENCE (NX,X)
;	COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY   MP=PLOTTER   MX=XGP
;	DATA M2/2/
FILLMS:	0
	MOVE PLTR+2		;
	MOVEM DX#		;	DX=DIS
	MOVE PLTR+1		;	RX=RHT
	MOVEM RX#
	MOVE @4(16)		;	D=RSTJ2*R6
	FMPR STF+10
	MOVEM D#
	MOVE @5(16)		;	R=RSTJ2*R7
	FMPR STF+10
	MOVEM R#
DIST2:	SKIPGE R9		;DISTORT IF R9.GE.0
	JRST FM1		;GO TO 1
	MOVE DST+1
	MOVEM C#		;	C=CC
	MOVE DST		;	B=BB
	MOVEM B#		;  SAVES IT.  IT WILL RETURN LATER.
	FDVR PLTR+2		;	BB=B/DIS
	MOVEM DST
	MOVE [1000.0]		;	CC=1000
	MOVEM DST+1
FM1:	MOVNI 13,2		;1	KK=-2
        SETZ 7,        		;  KK IS 13,  J IS 7	DO 205 J=1,L
	MOVEI 12,@1(16)		;LOC OF IDAT
FM205:	ADDI 13,3		;	KK=KK+3
				;	KX=KK+2
	JSA 16,UNPACK	 	; CALL UNPACK(M,N,IDAT(J))
	4			;X COORD.
	5			;Y COORD.
	(12)			;	;  12 IS IDAT ARRAY
	AOJ 12,			; UPDATE POINTER
	MOVEM 1,RINP+1(13)	; LL (=2 PEN DN., =3 PEN UP.)
	FLTR 4 			;	X(KK)=(R2+D*M)*DIS
	FMPR D			;CC	X(KK)=ROFF((R2+D*M)*DIS)
	FADR @2(16)
	FMPR PLTR+2
	MOVEM RINP-1(13)	; X COORD.
	FLTR 5  			;CC	X(KK+1)=ROFF((CENTR+R*N)*RHT)
	FMPR R			;	X(KK+1)=(CENTR+R*N)*RHT
	FADR @3(16)
	FMPR PLTR+1
	MOVEM RINP(13)		; Y COORD.
DIST3:	SKIPGE R9
	JRST FM3 		;3	GO TO 205
	MOVM RINP-1(13)
	FMPR DST		;	X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
	MOVNS			;C  FOR DISTORTION
	FADR C
	FMPRM RINP(13)
	
FM3:	AOJ 7,			;205	CONTINUE
	CAME 7,@(16)
	JRST FM205
	ADDI 13,2		;	NX(3)=KX
	MOVEM 13,RINP+2
	MOVSI 201400
	MOVEM PLTR+2		;	DIS=1.0
	MOVEM PLTR+1		;	RHT=DIS
;;	MOVEI 10,1		;	IF(IPLT)M=RSIZ+.4
;;	MOVE [1.7]		;	IF(M.LE.0)M=1
;;	CAMLE DL		;	IF(M.GT.M2)M=M2
;;	AOJ 10,			; AC 10 HAS FILL INCREMENT

		;	SUBROUTINE FILLER(QQ,MD)
		;	COMMON /RINP/I(1) /ALF/NO,H(72) /PLTR/P,RHT,DIS
		;	DIMENSION Q(1)
		;  H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
;FILLER:	0		;	EQUIVALENCE (Q,I),(KNT,I(3))
	MOVE RINP		;	RL=Q(1)
	MOVEM LEFT#		; FLOATING!
	MOVEM RIGHT#		;	RR=RL
	SETZ 2,			;	DO 1 K=1,KNT,3
FL1:	MOVE RINP+2(2)		;CC	Q(K)=IFIX(Q(K))
	CAIN 3			;CC	Q(K+1)=IFIX(Q(K+1))
	SETOM RINP+2(2)		;DO THIS ABOVE?	IF(I(K+2).EQ.3)I(K+2)=-1

	MOVE RINP(2)		;	A=Q(K)
	CAMN RINP+3(2)		;	IF(Q(K+3).EQ.A)I(K+5)=-1
	SETOM RINP+5(2)		;C VERTICAL LINES WILL BE IGNORED.
	CAMGE LEFT		;	IF(RL.GT.A)RL=A
	MOVEM LEFT
	CAMLE RIGHT		;1	IF(RR.LT.A)RR=A
	MOVEM RIGHT		;C GET LEFT AND RIGHT EXTREME LIMITS.
	ADDI 2,3		;K=K+3
	CAMGE 2,RINP+2		;I(3)
	JRST FL1
	
	MOVN [0.5]		;	RR=RR-.5
;;	FADRM RIGHT
	FADRM LEFT		;	RL=RL-.5
FL2:	MOVSI 202600		;2	RL=RL+3
	FADRB LEFT		;C SLICE COUNTER
	CAML RIGHT		;	IF(RL.GT.RR)RETURN
	JRST FM6		;JRA 16,2(16)
	SETZ 11, 		;	M=0
	MOVEI 2,3		;	DO 3 J=4,KNT,3
FL3:	SKIPGE RINP+2(2)		;	IF(I(J+2))GO TO 3
	JRST FLX3
	MOVE RINP(2)		;A	IF(IHORZ(I,J,RL))GO TO 3
	MOVE 1,RINP-3(2)	;B	C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
	CAML 0,1		;	FUNCTION IHORZ(Q,J,RL)
	EXCH 0,1		;	DIMENSION Q(1)
	CAML 0,LEFT		;	IHORZ=-1
	JRST FLX3		;	A=Q(J)
	CAMG 1,LEFT 		;	B=Q(J-3)
	JRST FLX3		;PREVIOUS X COORD. IF(A.GT.B)CALL EXCH(A,B)
	AOJ 11,			;	IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
	             		;	M=M+1
				;	H(M)=HGT(J,RL,I)
	MOVE 3,RINP+1(2)		;	FUNCTION HGT(J,RL,Q)
	FSBR 3,RINP-2(2)		;	DIMENSION Q(1)
	MOVE LEFT		;	HGT=Q(J-2)
	FSBR RINP-3(2)		;C  PREVIOUS Y COORD.
	FMPR 3,0		;	A=Q(J-3)
	MOVE RINP(2)		;C  PREVIOUS X COORD.
	FSBR RINP-3(2)		;	HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
	FDVR 3,0		;CAN HAVE A DIVIDE BY ZERO HERE!!
	FADR 3,RINP-2(2)		;3	CONTINUE
	MOVEM 3,ALF(11)		;H(M)
FLX3:	ADDI 2,3
	CAMGE 2,RINP+2
	JRST FL3
	JUMPE 11,FL2		;	IF(M.EQ.0)GO TO 2
	          		;C  M=0=SPACE BETWEEN OBJECTS -- NO FILLER
	MOVEI 2,1		;	J=1
FL5:	MOVE ALF(2)		;5	IF(H(J).GE.H(J+1))GO TO 4
	CAML ALF+1(2)		;C  SORTS HEIGHTS
	JRST FL4		;	CALL EXCH(H(J),H(J+1))
	EXCH 0,ALF+1(2)
	MOVEM ALF(2)
	CAIN 2,1		;	IF(J.EQ.1)GO TO 4
	JRST FL4
	SOJ 2,			;	J=J-1
	JRST FL5		;	GO TO 5
FL4:	AOJ 2,			;4	J=J+1
	CAMGE 2,11		;	IF(J.LT.M)GO TO 5
	JRST FL5		;C GO BACK IF MORE SORTING TO BE DONE
	MOVEI 14,1		;	NN=1
FL6:	MOVE 13,ALF(14)		;CCCCC6	IF(H(NN).EQ.H(NN+1))GO TO 7
	MOVE 12,ALF+1(14)	;	A=H(NN)
	MOVE 13          	;	B=H(NN+1)
	FSBR 12
	CAMG [2.0]		;   IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
	JRST FL7
	FSBR 13,[1.0]
	FADR 12,[1.0]		;A IS 13,  B IS 12
	JSA 16,LINES
	JUMP LEFT
	JUMP 13
	JUMP [3]
	JSA 16,LINES
	JUMP LEFT
	JUMP 12
	JUMP [2]
FL7:	ADDI 14,2		;7	NN=NN+2
	CAMGE 14,11		;C SKIP BY 2'S
	JRST FL6		;	IF(NN.LT.M)GO TO 6
	JRST FL2		;	GO TO 2

FM6:	MOVE DX			;2	CALL FILLER(NX,M)
	MOVEM PLTR+2		;	DIS=DX
	MOVE RX			;	RHT=RX
	MOVEM PLTR+1
DIST4:	SKIPGE R9
	JRA 16,6(16)		;5	RETURN
	MOVE B			;C  NEXT TO RESET DISTORTION FACT.
	MOVEM DST		;	BB=B
	MOVE C			;	CC=C
	MOVEM DST+1
	JRA 16,6(16)		; 	RETURN
	END
BEND
BEGIN LINXG
	TITLE LINXG
	ENTRY LINES,PLOTS
	EXTERNAL DST,PLTR,DPY,.COMM.,ROFF,XRN,SQRT,PLOT,.COMM.

	KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
	RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
	HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15

		;	SUBROUTINE LINES(A,B,L)
		;	COMMON/DST/BB,CC
   		;	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
		;	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
		;	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
		;	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
		;	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
		;	1,(JJ2,JJ(2))
		;	DATA BB/.008/,CC/3.5/
 		;C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
	
	M←2 ↔ NZ←3 ↔ K←4
DEFINE R9< .COMM.+=10>

LINES:	0		;	GO TO 23
DIST1:	SKIPL R9
	JRST L23	;22	IF(JQ(1).NE.0)GO TO 23
	SKIPE PLTR+=27
	JRST L23	;	IF(CC.EQ.1000)GO TO 23
DIST:	MOVSI T,212764
	CAMN T,DST+1	;** FOR DISTORATION -- SEE ALSO FILLMS ***
	JRST L23	;	B=B*(CC-BB*ABS(A))
	MOVM T,@(16)
	FMPR T,DST	;BB IS DST, CC IS DST+1
	FSBR T,DST+1
	FMPRM T,@1(16)
	MOVNS @1(16)	;23	IF(IPLT)GO TO 2
L23:	SKIPGE PLTR
;;	JRST L2
	JRST L9
	MOVE	T,.COMM.+1	;IF(JA.EQ.44)RETURN
	CAIN	T,=44		;WON'T LOOK AT BARLINES FOR HEIGHT.
	JRA	16,3(16)
	MOVE	T,@1(16)
	CAMG	T,DPY+1
	JRST	L333
	MOVEM	T,DPY+1  ;  IF(B.LT.BOT)BOT=B
	JRA	16,3(16)
L333:	CAMG	T,DPY+2
	MOVEM	T,DPY+2
	JRA	16,3(16)  ;	IF(B.GT.TOP)TOP=B
			;2	IF(IPLT.EQ.-2)RETURN
;;L2:   	MOVNI T,2
;;	CAMN T,PLTR
;;	JRA 16,3(16)		;9	M=ROFF(A*DIS)
L9:   	MOVE M,@(16)
	FMPR M,PLTR+2
	SKIPGE M
	FADR M,[-=1.0]
	FADR M,[=0.5]
	KIFIX M,M
	MOVEM M,MM#		;	N=ROFF(B*RHT)
	MOVE NZ,@1(16)
	FMPR NZ,PLTR+1
	SKIPGE NZ
	FADR NZ,[-=1.0]
	FADR NZ,[=0.5]
	KIFIX NZ,NZ
	MOVEM NZ,NN#		;8	CALL PLOT(M,N,L)
L8:	MOVE T,@2(16)
	MOVEM T,LL#
	JSA 16,PLOT
	JUMP MM
	JUMP NN
	JUMP LL			;	END
	JRA 16,3(16)

PLOTS:	0
	JRA	16,1(16)	; DUMMY ROUTINE

J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
Y←13↔ X←14↔ L←15↔ M←1
JPOS:	0		;C  BLACKS IN NOTES
IPOS:	0	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
IC:	0
KZ:	0

	END
BEND